C**SUBRS.  SLUR, (JUGGLE), (LOOP), (PLTSRT), (LINES), (HOMER),
C  SCL,(FORMAT), IBLANK, BMX, ACSHFT, SETUP, TYPE, SETLET, BEAMX

	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON/SLR/ SLURX(32)
	REAL CENTR
	COMMON /XRN/RN(1) /PLTR/PLT,RHT,RDIS 
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
	COMMON/PTR/PWDS(1) /STF/RSTFAC(0/7),RSTJ2 
	1 /LIMIT/LIMIT,ITEM,L,I,IX /ALF/INP,SLURY(72) 
CC	DATA RSLUR/22.0/
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	

CCC	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSTJ2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CCC	CALL CIRCLE
CCC	RETURN

C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
C  P9=NUM IN BRACKET(IF NON-ZERO)
2	IF(J8.GE.7)CALL BRKSLR
C J8=7=SLUR WITH VERT. BRKTS.  =8=BRKT ON LEFT ONLY. =9=ON RIGHT ONLY.
	J10=1
	J4=-1
	J5=1
C  ↑↑↑↑ FOR DPY ONLY (32 SEGS ARE USED)
	TWICE=-1
	IF(R3.GT.-1000)GO TO 2100
	R=-R3-1000
	L=R
	R=-(R3+1000+R)
	R3=RN(PWDS(L)+4)+R
2100	IF(R6.GT.-1000)GO TO 21  
	R=-R6-1000
	L=R
	R=-(R6+1000+R)
	R6=RN(PWDS(L)+4)+R
COCT	IF(R6)R6=202
C  R6=NEG. IS FOR PAGE-LAYOUT PROG. TELLS WHICH NOTE TO SLUR TO.
21	RST7=RSTJ2*7.
	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	R7=AMOD(R7,100.0)
	IF(RJ.LT.300)GO TO 20
	RJ=0
CC*** NOT YET!	R5=R5-(2*R7)
C R5 THINKS THE SLUR ISN'T REVERSED.
C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
20	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
CC5	R=32
5	R=30
C AFTER DOTTED NOTE
	GO TO 8
6	R=22
CC6	R=RSLUR
C BETWEEN NOTES
CC8	RX=-1.3
8	RX=-0.75
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX**2+RTILT**2)
	IF(J8.NE.-1)GO TO 1
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)*1.0
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	L=32
	CALL SLOOP

CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
	J6=J10
	J7=L
	IF(J4.NE.0)GO TO 22
	CALL EXCH(J6,J7)
	J5=-1

22	IF(J11.NE.0)J11=3
	CALL SLRS

C22	IF(J11.EQ.0)GO TO  122
CC	IF(MOD(J11,2).EQ.0)J11=J11+1
C MAKE SURE WE HAVE AN ODD NUMBER OF SEGMENTS FOR DASHES.
C	J11=3
C	KD=2
C	KT=0
C	KA=1
C THIS WILL MAKE DASHED SLURS  J11 HAS DASH SIZE.
C	DO 188 K=J6,J7,J5
C	KT=KT+1
C	IF(KT.LT.J11)GO TO 188
C	KT=0
C	KD=KD+KA
C	KA=-KA
C  BLANK-DASH FLIP-FLOP
C188	CALL LINES(SLURX(K),SLURY(K),KD)
C	GO TO 123

C122	DO 88 K=J6,J7,J5
C88	CALL LINES(SLURX(K),SLURY(K),2)
123	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C  DISPLAY END POINT OF SLUR
	IF(TWICE)RETURN
	TWICE=TWICE-1
	GO TO 182
180	RW=R+R7*RST7
	TWICE=-1
CC	KQ=1
	J5=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	RZ=RTILT/(RX-R3)
	TWICE=2
CC	RZ=RX-R3
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C  SIZE(R6) IS 0.875   R7=1 IS FOR ITALICS
	R7=1
	R8=0
	CALL MAKNUM(R9)
	END

	SUBROUTINE SCL
C  SETS UP SCALING MARKERS.
	COMMON /STF/RSTFAC(0/7),RSTJ2 /RINP/SU(900)
	COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
	1 /POSI/STFF(0/7),J102,POS
	J2=R2
	IF(J2.NE.99)GO TO 1008
	CALL HYDPOG(2)
	RETURN
1008	J5=0
	J6=0
	RSTJ2=RSTFAC(J2)
C  SETS UP SCALE LINES.
	J4=200
	IF(R3.NE.0)J4=400
C  PUTS SCALE TO 400
	R2=STFF(J2)+60.*RSTJ2
	RJ=R2+60.
	CALL DPYSET(2,SU,700)
	CALL DPYBRT(3)
	POS=RJ+40.
	RSTJ2=1.
	DO 1002 MX=10,J4,10
	RA=RHORZ(FLOAT(MX))
	R3=RA-58
	IF(MX.GT.10)CALL PNUM
CC1005	IF(R5.NE.0)GO TO 1007
C  JUMP FOR STAFF NUMBERS
	CALL LINX(RA,R2,RA,RJ)
	J5=J5+1
1002	IF(J5.EQ.10)J5=0
	CALL LINES(-596.0,RJ,2)
	CALL LINES(-596.0,R2,2)
	R6=1.5
C  NEXT SETS UP STAFF NUMBERS  TO FAR RIGHT(OUT OF WAY OF TYPING.)
	R3=615.
	DO 1007 K=0,7 
	POS=STFF(K)+40.
	J5=IABS(K)
	CALL PNUM
1007	CONTINUE
CC	CALL DPYDO(2)
  	CALL DPYOUT(2)
	CALL SETPOG(1)
	END

	FUNCTION IBLANK(IS,N)
	COMMON /XRN/RN(2000)
	IBLANK=0
	IF(AMOD(RN(IS+N),100.0).EQ.99.0)IBLANK=-1
	END

	SUBROUTINE BMX(RA)
C  RA=NUMB. OF TAILS
C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
	COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(1)
	1 /RINP/R(10,85),VQ(100) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND /RNW/RNW
	1/LIMIT/LIMIT,ITEM,LL,IS,IX /SC/J,L,MK
	1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
	1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
	1 /SCX/JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
	M=IS-12
	RX7=RN(7+M)
C ORIGINAL STEM DIR. AND NUM. OF BEAMS INFO.
	DO 1 L=KN,K
	B=R(7,L)
	JB=B/10
	B=B-JB*10
C???	B=AMOD(R(7,L),10.0)
	IF(R(8,L).EQ.1000.)B=0
C AVOIDS GRACE NOTES AND NON-NOTES
	IF(R(1,L).NE.1)B=0
1	VQ(L)=B
	VQ(K+1)=0
C   CLEARS IT FOR ROUTINE AT '3'
	JB=KN
	RX8=0
	JBX=0
C THE ABOVE 2 ARE FOR NEW COMPOSITE BEAM FEATURE 5/78

6	DIS=0
	RB9=0
	DO 2 L=JB,K
	IF(VQ(L).LE.RA)GO TO 2
C  SKIP IF EQ. TO PRESENT BEAM
	RB=VQ(L)
	LL=L
4	DO 11 JD=LL,K
	VQX = VQ(JD)
	IF(VQX.GE.RB)GO TO 20
	IF(VQX.EQ.0)GO TO 11
C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
21	B=10.
	IF(LL.GT.KN)GO TO 13
	GO TO 16
20	JV=JD
	IF(VQX.GT.RB)GO TO 21
11	JW=JD
	B=20
C  FINDS NEED FOR BEAM TO LEFT 
16	B=B+RA
	IF(JBX)GO TO 50
C  FOR NEW COMPOSITE BEAM FEATURE 5/78
	JE=RN(7+M)/10.
	RN(7+M)=JE*10.+RA
	GO TO 51
50	DO 5 JE=1,6
5	RN(JE+IS)=RN(JE+M)
	RN(7+IS)=RX7+RB-RA*2.
C  ADDS RIGHT NUM. OF BEAMS
51	IF(LL.NE.JV)GO TO 10
	IF(LL.EQ.KN)GO TO 377
	IF(LL.NE.K)GO TO 10
377	B=-B
C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
	GO TO 8
13	IF(JV.GT.LL)GO TO 14
	IF(R(7,LL+1).LT.10)GO TO 15
C NEXT FOR DOT ON FOLLOWING NOTE.
	DIS=10.
	GO TO 19
15	DIS=20.
C SHORT INNER BEAM TO LEFT OF STEM
19	B=-RA
	GO TO 16
14	DIS=30
C  LONG INNER BEAM
	JV=-JV
	GO TO 16

C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
10	IF(LL.EQ.KN)GO TO 22
	IF(JV.GE.0)GO TO 17
	B=R(3,LL)
	JV=-JV
	LL=JV
22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
	VQ(JW)=VQ(JW+1)
	JW=JW-1
17	IF(LL.NE.JB)GO TO 18
	IF(B.LT.20.)LL=JV
C PUTS BEAMS IN RIGHT PLACE.
18	RC=R(10,LL)
	IF(RC.EQ.0)GO TO 23
	RB=RNW*RSTJ2
	IF(ABS(R(4,LL)).GE.100)RB=RB*.6
C  GET WIDTH OF NOTE(RNW) FOR DISPLACEMENT
	IF(RC.EQ.2)RB=-RB
	RC=RB
23	RB9=RC+R(3,LL)
C  THIS WILL BE POS.3
	DIS=RA+DIS
C  DISPLACES
	GO TO 8
2	CONTINUE
	RETURN
8	JB=JW+1
C  FINDS SIDE (L,R) FOR PARTIAL BEAM
C  FOR NEW DISPLACEMENT
	RN(IS+11)=-1
	IF(RB9+DIS.EQ.0)GO TO 31
	IF(DIS.LT.10)GO TO 32
	IF(DIS.LT.30)GO TO 33
C INNER PARTIAL BEAM IS NEXT
	DIS=DIS-30
	GO TO 31
32	IF(B.GE.20)GO TO 12
	DIS=B-10
	B=-1
C  -1 PICKS UP POS OF P3
	GO TO 31
12	DIS=B-20
	B=RB9
	RB9=-1
C  -1 IN P9 WILL PICK UP POS OF P6
C  INNER BEAM ATTACHED TO LFT SIDE.
	GO TO 31
33	B=-DIS
	DIS=0
31	L=IS
	IF(JBX)GO TO 53
	L=M
	DIS=(RB-RA)*100.+1.
53	IF(RX8.GT.1.)GO TO 52
	IF(RB9.NE.0)GO TO 52
	IF(RX8.NE.0)GO TO 54
	RX8=B
	GO TO 52
54	RN(8+M)=-30
C TWO UNATTACHED BEAMS, LEFT AND RIGHT
	RX8=1
	GO TO 55
52	RN(8+L)=B
	RN(9+L)=RB9
	RN(10+L)=DIS
	IF(JBX)CALL UPDATE(9)
C  ADDED ANOTHER ITEM (PART. BEAM)
	JBX=-1
	JA=0
55	IF(JB.LE.K)GO TO 6
	END

	SUBROUTINE ACSHFT(RX)
	COMMON /XRN/RN(1) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
	1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
	1 /RINP/R(10,85),VQ(100)
	EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
	1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
	Z=0
	L=K-1
	M=L-ABS(RX)
	JD=1
	RN1=99
	Y=-.23
	IF(RX.LT.0)GO TO 1
	L=M
	M=K-1
	JD=-1
1	DO 2 N=M,L,JD
C  DOES IT HAVE AN ACCID?
	IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
	A=0
	B=0
	IF(N.LT.L)A=R(6,N+1)
	IF(N.GT.M)B=R(6,N-1)
	IF(RN1.NE.99)GO TO 3
C  IS THIS THE FIRST ACCID?
	RN1=R(4,N)
	GO TO 6
3	RH=R(4,N)
	IF(ABS(RH-RN1).LT.5)GO TO 4
	RN1=RH
	IF(Y.GT.0)Z=Z+.04
C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
	Y=-.23+Z
6	IF(A.EQ.20)GO TO 477
	IF(B.NE.20)GO TO 4
477	Y=Z
4	X=0
	IF(R(6,N).EQ.20)X=-.24
	IF(R(6,N).EQ.10)X=.24
	Y=Y+.23
	IF(X+Y.LT.1)GO TO 7
	RN1=RH
	Z=Z+.04
	Y=0
	IF(A.EQ.20)GO TO 677
	IF(B.NE.20)GO TO 577
677	Y=.23
C  SO Y DOESN'T GET >1.
577	Y=Y+Z
7	X=X+Y
	IF(ABS(X-.04).LT..01)X=0
	IF(X.GE.0)GO TO 5
	Y=.23+Z
	X=Z
5	R(5,N)=R(5,N)+X*RSTFAC(IFIX(STAFF))
C  SPACING OF ACCI. DEPENDS ON STAFF SIZE FACTOR AT THIS POINT
2	CONTINUE
	END

C SETUP ALLOWS SETING UP RHYTHMS ON DESIGNATED STAFF FOR SPACING ALL OTHERS.
	SUBROUTINE SETUP
	INTEGER PWDS
  	COMMON /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
	1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
	1 /DPY/ST(4000),MEDIT,GO /XRN/RN(1)
	1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
	1 ENDP,RA,RDD,ITB,POSB
	DIMENSION RPOS(2,100)
	EQUIVALENCE (RPOS,ST(3400))

C  RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
	STUP=-1
C  THIS SENDS INFO TO SUBR. NOTES
	IF(SET4.GT.7)RETURN
C  **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
	IF(ITEM.EQ.0)RETURN
	JX=0
	RA=0
	DO 9534 K=1,ITEM
	L=PWDS(K)
      IF(RN(L+2).NE.SET4)GO TO 9534
	RD=RN(L+1)
	IF(RD.LT.5)GO TO 5
	IF(RD.LT.17)GO TO 9534
5	IF(RD.GT.2)GO TO 6
	RC=7
	IF(RD.EQ.2)RC=5
	IF(RN(L).LT.RC)GO TO 9534
	M=9
	IF(RD.EQ.2)M=7
	RC=RN(L+M)
	IF(RC.EQ.0)GO TO 9534
C  FOR OTHER NOTES ON SPACING STAFF.
	IF(RC.EQ.4./88.)GO TO 9534
C THESE FOR GRACE NOTES   (1/88 NOTES)
	GO TO 7
C  SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
6	IF(RD.NE.3)GO TO 8
	IF(RN(L).LT.3)GO TO 7
	RC=RN(L+5)
	IF(RC.GE.100)GO TO 7
	IF(RC.GT.3)GO TO 9534
C  SKIPS IF NOT A REAL CLEF  (+100=MINI CLEF)
	GO TO 7
8	IF(RD.NE.4)GO TO 10
	IF(RN(L).GT.2)GO TO 9534
C  SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
10	IF(RD.NE.2)GO TO 7
	IF(RN(L).LT.5)GO TO 9534
	IF(RN(L+7).EQ.0)GO TO 9534
7	JX=JX+1
	RPOS(1,JX)=RN(L+3)
	IF(RD.GT.2)GO TO 3
C JUMP WHEN TIME VALUES ARE IN P8
C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
277	RA=RA+RC
C  SUM OF RHYTHS
	GO TO 77
3	RC=-RD
77	RPOS(2,JX)=RC
C  RC IS RHYTHMIC VALUE OF NOTE.
9534	CONTINUE
C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
	IF(RA.EQ.0)RETURN
C  RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF. 

	CALL SORT2(RPOS,JX)
	ENDP=200.
	IF(RPOS(2,JX))ENDP=RPOS(1,JX)
	DO 1 L=1,JX
1	IF(RPOS(2,L).GT.0)GO TO 4
4	RD=RPOS(1,L)
	RB=ENDP-RD
C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
	RC=RPOS(2,L)
	RPOS(2,L)=RD
C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
	DO 2 K=L+1,JX
	RE=RPOS(2,K)
	IF(RE)GO TO 2
	RD=RC/RA*RB+RD
	RC=RE
	RPOS(2,K)=RD
2	CONTINUE
C  1,K=REAL POS.    2,K=AVERAGED POS.
C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
	JX=JX+1
	RPOS(1,JX)=ENDP
	RPOS(2,JX)=ENDP
	STUP=0
C  THIS FOR NOTES AND RHYTH
	END

	SUBROUTINE TYPE
	COMMON/ALF/INP(72),ML /IDEV/IDEV /MKX/KSLA,ISEMI,LESS,IGT
	IF(IDEV.NE.5)GO TO 2
1	CALL TYPSTR('TYPE --')
	CALL TYPCRL
2	READ(IDEV,2114,END=167)INP
	IF(INP(1).EQ.LESS)GO TO 167
	IF(INP(1).NE.IGT)RETURN
	IDEV=1
	GO TO 2
167	IDEV=5
	GO TO 1
2114	FORMAT(72A1)
C  FOR 'SCORE' INPUT
	END

	SUBROUTINE SETLET
	COMMON/SCM/V(76),RR4,NN,Y,LCNT,STAFF,JLIST(200),REND
C  NOTE DIFFERENCE IN V ARRAY LNGTH  76+RR4+NN
	COMMON /MKX/KSLA,ISEMI,LESS,IGT
	COMMON R2,JA,CENTR,J2,R3,R4,R5,RJQ(17),JQ(14),M,K,J,X,A,JR
	1 /PTR/PWDS(1)  /IDEV/IDEV
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),KK /ALF/INP(72),ML
	COMMON/SCN/LEL,LR,LU,LD,SLA,LE,LC,LS,LF,LA,LI,LW
	1 /POSI/STFP(0/7),J102,POS /LIMIT/LIMIT,ITEM,L,I,IX /XRN/RN(1) 
	1 /RINP/RPOS(2,450) /DPY/ST(4000),MEDIT,IGO
	DIMENSION SU(320)
	EQUIVALENCE (J5,JQ(3)),(ISET,RJQ(9)),(SU(1),ST(3600))
	KK=L
C  L=NUMBER OF ITEMS TYPED +1
	M=1
	IF(R4.EQ.0)KK=0
C  =0 ALWAYS WANTS PAIRS OF NUMS.
	RR4=R4
C  GIVEN VERTICAL POS.
	R4=20
	RPOS(1,1)=0
	DO 1 K=1,ITEM
	IF(FINDIT(K))GO TO 1
C SKIPS NON-NOTES AND WRONG STAFF
	M=M+1
	RPOS(1,M)=RN(L+3)
1	CONTINUE
	IF(M.EQ.1)RETURN
C  M=1 MEANS NO NOTES ON THIS LINE
	CALL DPYSET(3,SU,320)
	CALL DPYBRT(6)
	POS=STFP(J2)
	J5=1
	CALL SORT2(RPOS,M)
	K=2
	JSET=ISET
22	IF(IFIX(RPOS(1,K)*100.).NE.IFIX(RPOS(1,K-1)*100.))GO TO 2
C  ROUNDS OFF POSITION TO 2 DECI. PLACES
	M=M-1
	DO 20 J=K,M
20	RPOS(1,J)=RPOS(1,J+1)
C  DELETES DOUBLE-STOPS - DOESN'T PUT NUM OVER 1ST NOTE.
	IF(M.LT.K)K=M
	GO TO 22
2	K=K+1
	IF(K.LT.M)GO TO 22
	DO 4 K=2,M
	R3=RHORZ(RPOS(1,K))
	CALL PNUM
	J5=J5+1
4	IF(J5.EQ.10)J5=0
	CALL DPYOUT(3)
CC	CALL DPYDO(3)
	CALL SETPOG(1)
	RPOS(1,M+1)=200
	NN2=1
	J=1
	JJ=1
C  FLAG FOR ALL BLANKS AT END OF LINE
30	MM=-1
	K=JJ
300	LL=INP(K)
	IF(LL.NE.' ')MM=0
	IF(LL.EQ.KSLA)GO TO 301
	IF(K.GE.72)GO TO 301
	K=K+1
	GO TO 300
167	IDEV=5
301	IF(MM)GO TO 31
	IF(IDEV.EQ.1)GO TO 1301
	CALL TYPSTR(' POS. FOR --  ')
	DO 302 LL=JJ,K
302	CALL TYPCHR(INP(LL),1)
	CALL TYPSTR('   ')
1301	NN=NN2
	NN2=NN2+1
	IF(NN.GT.1)GO TO 1267
	READ(IDEV,F78F,END=167)V
	IF(V(1).NE.99.)GO TO 2267
C READS 38 NUMS. 1ST TIME.  NOW '99' = 1,2,3,...38  (VERT. PRESET)
	X=0
	DO 3267 LL=1,76,2
	X=X+1.0
	V(LL)=X
3267	V(LL+1)=RR4
5267	NN=76
	GO TO 31
2267	IF(V(3).EQ.0)GO TO 267
C NOTE NUMS CAN BE ON 1 LINE IF THERE ARE >2.  (VERT. POS. MUST BE PRESET)
	NN=38
	DO 4267 LL=76,1,-2
	V(LL)=RR4
	V(LL-1)=V(NN)
4267	NN=NN-1
	GO TO 5267
1267	READ(IDEV,F78F,END=167)V(NN),V(NN2)
	REREAD FA1,JJ
	IF(JJ.EQ.LESS)GO TO 167
	IF(JJ.NE.IGT)GO TO 267
	IDEV=1
	GO TO 302
267	IF(RR4.NE.0.AND.V(NN2).EQ.0)V(NN2)=RR4
	NN2=NN2+1
	V(NN2)=0
	JJ=K+1
	IF(K.LT.72)GO TO 30	

31	X=V(J)+1
	IF(KK.NE.0)KK=NN-1
	DO 32 K=NN,1,-1
32	IF(V(K).NE.0)GO TO 320
320	IF(K.GT.KK)KK=-1
C  NOW PAIRS OF NUMS WILL SET INDIV. VERT. POS.; SINGLE DON'T
	IF(RN(ISET+1).NE.16.)GO TO 6
C TRAP DASH AT FIRST OF LINE.
3	K=X
	A=RPOS(1,K)
	B=RPOS(1,K+1)
	RN(ISET+3)=A+(B-A)*(X-K)
CCC	RN(ISET+3)=A+(B-A)*(X-K)+DISP
C  DISP IS DISPLACEMENT OF CURRENT LETTERS.
	IF(KK.GT.0)GO TO 5
C  NEXT FOR PAIRS OF NUMS.
	RN(ISET+4)=V(J+1)
	J=J+2
	GO TO 6
C IF P4≠0 TYPE ONLY 1 # FOR EACH ITEM. ALL ITEMS WILL BE AT VRT PS OF P4
C TYPE Nn, Vert pos/Nn, Vert pos/  OR  Nn/Nn/ (if P4≠0)
5	J=J+1
6	ISET=ISET+RN(ISET)+3
	IF(ISET.GE.I)GO TO 7
	IF(RN(ISET).EQ.8)GO TO 6
C  =8 MEANS MORE LETTERS TO COME.
	X=V(J)+1
	IF(X.GT.1)GO TO 3
C CAN'T PUT LETTER AT POS. 0 *********
	IF(IDEV.EQ.1)RETURN
7	K=ITEM+1
	CALL TYPSTR('FIRST ITEM WAS ')
	CALL TYPINT(K)
	CALL TYPCRL
C NOW CHECK FOR DASHES
17	IF(RN(JSET+1).NE.4)GO TO 117
	RN(JSET+3)=RN(ISET+3)+1.
C ASSUMES SOME CODE 16 CHAR. JUST BEFORE DASH.    IX IS TOTAL NUM. OF ITEMS.
	CALL DASHES(IX,R2,RN(JSET+3),RN(JSET+4),RN(JSET+5),RN(JSET+6))
117	ISET=JSET
	JSET=JSET+RN(JSET)+3
	IF(JSET.LT.I)GO TO 17
	END
	
	SUBROUTINE BEAMX
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RRJJ/RJJ2,RJJ(20)
	1 /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
	1 (R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,RJQ(5))
	1,(R3,RJQ(1)),(J8,JQ(6)),(J7,JQ(5))
	1,(R11,RJQ(9)),(R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1))
	1,(R9,RJQ(7)),(J9,JQ(7))

	IF(J10.GE.100)GO TO 6
	CALL BMSTF
	RETURN
6	JZ=-2
	JX8=R8
	IF(JX8.GE.-1)GO TO 16
	JX8=R8/10.0
	JX8=JX8*10
C MAKE SURE LAST DIGIT IS ZERO
	R8=JX8
16	RR8=R8
	R8=0
	RR9=R9
	R9=0
	RR6=R6
	RR3=R3
	RR4=R4
	RR5=R5
	RSTJ=RSTJ2
	J=10*(J7/10)
C J=STEM DIR. (10 OR 20)
	JJ=J10/100
	JJ10=J10-JJ*100
C IF 3RD DIGIT OF P10 = 0, THEN TWO SECONDARY BEAM GROUPS ARE MADE.
C  THEN P8 AND P9 ARE THE LIMITS OF THE GAP BETWEEN THE SECONDARY GROUPS.

C IF 3RD DIGIT OF P10 = 1, THEN SINGLE SECONDARY BEAM GROUP IS MADE.
C  THEN P8 AND P9 ARE THE OUTER LIMITS OF THE SECONDARY GROUP
	JJ7=J7-J
C   J7=NUM. OF FULL BEAMS   (1ST DIGIT OF P10=NUM OF ADDED BEAMS)
7	J10=0
5	J8=R8
	J9=R9
	R7=J7
	R10=J10
	CALL BMSTF
	JZ=JZ+1
	IF(JZ)1,2,3          
3	RETURN

1	IF(RR8.GE.0)GO TO 8
	IF(JX8.GE.-20)GO TO 11
C UNATTACHED PARTIAL BEAM: 
C  P8= -10=ON LEFT, -20=RIGHT, -30=BOTH
	RR8=RR8+10
	IF(JX8.EQ.-31)GO TO 11
	JX8=JX8-1
	RR9=0
C ↑↑↑ A PRECAUTION
	JZ=JZ-2
11	R8=RR8-AMOD(R7,10.0)
10	R9=RR9
	JZ=JZ+1
	GO TO 4
8	IF(JJ10.EQ.0)GO TO 9
C NEXT MAKES ONE SECONDARY BEAM GROUP.
	R8=RR8
	GO TO 10
9	R8=-1
	R9=RR8
4	J7=J+JJ
	R6=RR6
	R3=RR3
	J3=RR3
	R4=RR4
	R5=RR5
	J10=JJ7
C J10 IS DISPLACEMENT FOR OTHER BEAMS
	RSTJ2=RSTJ
	GO TO 5
2	R8=RR9
	R9=-1
	GO TO 4
	END